COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	T 
C00026 ENDMK
C⊗;
T 
NIL 


(PROGN
 (SETQ SAIL-MORE-SYSFUNS '(DO-EXECUTE-MEMQ %%DESTRUCTURE1%%
					   %%DESTRUCTURIFY%%
					   %%PATHIFY%%
					   %%CODE-PATH))
 (SETQ *RSET NIL NOUUO NIL NORET 'T)
 (SETQ CCLOAD:PUTPROP PUTPROP CCLOAD:PURE PURE)
 (PROG (GL LVRL FLPDL TIME RUNTIME PUTPROP PURE ALARMCLOCK SLOTX
	REGACS NUMACS MODELIST FASLOAD UNSFLST FXPDL REGPDL
	NLNVTHTBP *PURE CCLOAD:CLOCK-SLOWDOWN CCLOAD:CLOCK-INTERVAL
	CCLOAD:CLOCK-EPSILON CCLOAD:TIME-TEMP CCLOAD:OTIME-TEMP
	CCLOAD:FLUSH-TTY CCLOAD:DEV-DIR) 
       (SETQ RUNTIME (RUNTIME) 
	     TIME (TIME) 
	     FXPDL (STATUS FEATURE NOLDMSG) 
	     *PURE 'T 
	     PURE CCLOAD:PURE 
	     PUTPROP (APPEND '(STATUS SSTATUS
				      INST
				      INSTN
				      IMMED
				      CARCDR
				      NUMBERP
				      ARITHP
				      NOTNUMP
				      CONTAGIOUS
				      COMMU
				      ACS
				      CONV
				      MINUS
				      BOTH
				      FLOATI
				      P1BOOL1ABLE
				      FUNTYP-INFO
				      ARGS)
			     CCLOAD:PUTPROP))
       (ALLOC '(FIXNUM (4000 24000 0.25) FLONUM (400 10000 
0.1) BIGNUM (400 10000 0.1) SYMBOL (3000 20000 0.25) ARRAY
		       (100 2000 100)))
       (AND (STATUS FEATURE ITS)
	    (ALLOC '(LIST (34000 120000 0.35))))
       (SSTATUS FEATURE NOLDMSG)
       (SETQ CCLOAD:CLOCK-EPSILON 3.0 FLPDL 'T)
       (SETQ NUMACS '(LAMBDA NIL (ALARMCLOCK 'TIME -1)
				 ((LAMBDA (↑W ↑R) 
					  (PRINC '|/
Clock-OFF |					 TYO))
				  NIL
				  NIL)
				 (SETQ ALARMCLOCK NIL 
				       ↑W 'T 
				       CCLOAD:FLUSH-TTY 'T 
				       SLOTX REGACS)) 
	     REGACS '(LAMBDA NIL (SETQ ALARMCLOCK
				       MODELIST
				       ↑W
				       NIL
				       SLOTX
				       NUMACS
				       CCLOAD:FLUSH-TTY
				       NIL
				       CCLOAD:CLOCK-SLOWDOWN
				       40.0
				       CCLOAD:CLOCK-INTERVAL
				       12)
				 ((LAMBDA (↑W ↑R) 
					  (PRINC '|/
Clock-ON |					 TYO))
				  NIL
				  NIL)
				 (ALARMCLOCK 'TIME 1)))
       (COMMENT)
       (SETQ 
	MODELIST
	'(LAMBDA (VGO) 
		 (COND (CCLOAD:FLUSH-TTY (ALARMCLOCK 'TIME -1))
		       ('T
			(COND ((AND (> (-$ (SETQ CCLOAD:TIME-TEMP
						 (TIME))
					   CCLOAD:OTIME-TEMP)
				       CCLOAD:CLOCK-EPSILON)
				    (NOT CCLOAD:FLUSH-TTY))
			       (PRINC '|/
Using | TYO)		       (PRINC (*QUO (FIX (*QUO (- (RUNTIME)
							  RUNTIME)
						       
100000.0))				    10.0)
				      TYO)
			       (PRINC '| secs so far, out of |
				      TYO)
			       (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME)
						     
10.0))					    10.0)
				      TYO)
			       (PRINC '| | TYO)
			       (SETQ CCLOAD:TIME-TEMP (TIME))))
			(COND ((> (-$ (SETQ CCLOAD:OTIME-TEMP
					    CCLOAD:TIME-TEMP)
				      TIME)
				  CCLOAD:CLOCK-SLOWDOWN)
			       (SETQ CCLOAD:CLOCK-SLOWDOWN
				     (*$ 2.0 CCLOAD:CLOCK-SLOWDOWN)
				     CCLOAD:CLOCK-INTERVAL
				     (* 2 CCLOAD:CLOCK-INTERVAL))))
			(ALARMCLOCK 'TIME
				    CCLOAD:CLOCK-INTERVAL)))))
       (SETQ ↑Q NIL)
  A    (PRINC '|/
PURE = (type ? for help) | TYO)
       (CLEAR-INPUT TYI)
       (COND
	((MEMQ (SETQ PURE (CDR (ASSQ (READCH TYI NIL)
				     '((/1 . 1) (| | . | |)
				       (? . ?) (T . T) (N . N)
				       (X . XC) (/t . T) (/n . N)
				       (/x . XC) (L . LAP)
				       (/l . LAP)))))
	       '(? NIL))
	 (AND (NULL PURE)
	      (PRINC '|/
;Not acceptable, try again!/
|))	 (AND (OR (STATUS FEATURE ITS)
		  (STATUS FEATURE DEC20)
		  (STATUS FEATURE SAIL))
	      (PRINC '|/
;    <space> 	Same as "1" below |))
	 (PRINC
	  '
|/
;    1	  Use the UUOLINKS table for function-to-function calls/
;	    and prepare for making code read-only ("pure" loading)/
;    N    Regular FASLOADing, fun-to-fun linkage by PUSHJ P,.../
;    T	  Pure loading, but no UUOLINKS/
|	  TYO)
	 (AND
	  (STATUS FEATURE ITS)
	  (PRINC
	   '
|/
;    L    Use COMPLR LAP file instead of COMPLR FASL, /
;	    ask again whether FASLAP is wanted/
;    X    Do (SSTATUS FEATURE XC), "pure" load using UUOLINKs /
;	    this is for creating an experimental compiler/
|	   TYO))
	 (GO A))
	((AND (EQ PURE '| |)
	      (OR (STATUS FEATURE ITS)
		  (STATUS FEATURE DEC20)
		  (STATUS FEATURE SAIL)))
	 (SETQ PURE (COND ((STATUS FEATURE ITS)
			   (CURSORPOS NIL 31)
			   (PRINC '| 1 | TYO)
			   1)
			  ('T
			   (PRINC '|1 |)
			   (COND ((STATUS FEATURE SAIL) 1) (-1))))))
	((FIXP PURE)
	 (SETQ PURE (COND ((AND (STATUS FEATURE DEC10)
				(NOT (STATUS FEATURE SAIL)))
			   -1)
			  (1))))
	((EQ PURE 'N) (SETQ PURE NIL))
	((AND (MEMQ PURE '(XC LAP)) (STATUS FEATURE ITS))
	 (SSTATUS FEATURE XC)
	 (AND (EQ PURE 'XC) (SETQ PURE 1)))
	('T
	 (PRINC '|/
You blew it!!  Try again| TYO)
	 (GO A)))
       (AND (STATUS FEATURE EXPERIMENTAL)
	    (NOT (STATUS FEATURE XC))
	    (SSTATUS FEATURE XC))
       (SETQ CCLOAD:OTIME-TEMP (TIME))
       (COND ((STATUS FEATURE ITS)
	      (SSTATUS TTYIN
		       36
		       '(LAMBDA (VGO VGOL) (FUNCALL SLOTX)))
	      (FUNCALL REGACS)))
       (AND (NOT CCLOAD:FLUSH-TTY)
	    (PRINC '|/
  (In LISP version | TYO)
	    (PRINC (STATUS LISPV) TYO)
	    (PRINC '|)|)
	    TYO)
       (OR (NOT (STATUS FEATURE ITS))
	   (NOT (STATUS HACTR))
	   (VALRET (COND ((OR (NOT (FIXP PURE)) (STATUS FEATURE XC))
			  '|↔≠:JCL/
XCOMPL≠≠J:VP |)		 ('|↔≠:JCL/
COMPLR≠≠J:VP |))))
       (SETQ 
	LVRL
	'((LAMBDA (PURE) 
	   (COND
	    ((GET 'LAP 'FSUBR))
	    ((OR (AND (SETQ LVRL (GET 'LAP 'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;LAP FASL has not been found.  Please load it, and resume by <altmode>
P |)	     (BREAK LOAD-LAP-FASL-PLEASE)))
	   (PAGEBPORG)
	   (PURIFY 0 0 'BPORG)
	   (SETQ LVRL 'T))
	  (COND ((FIXP PURE) PURE) ('T)))
	GL
	'((LAMBDA (PURE) 
	   (COND ((STATUS FEATURE SAIL)
		  (HELP)
		  (AND (NOT CCLOAD:FLUSH-TTY)
		       (PROG2 (TERPRI)
			      (PRINC '|Loading gc-overflow-daemon |)))
		  (LOAD '((DSK (AID RPG)) DEMON FAS))
		  (SETQ GC-OVERFLOW 'GC-OVERFLOW-DAEMON)
		  (DEFUN SAVE-COMPILER (GL) 
			 (CDUMP (MAKNAM (APPEND (EXPLODEN '|SAVE |)
						(EXPLODEN GL)))))))
	   (COND
	    ((GET 'LET 'MACRO))
	    ((OR (AND (SETQ LVRL (GET 'LET 'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;LET FASL has not been found.  Please load it, and resume by <altmode>
P |)	     (BREAK LOAD-LET-FASL-PLEASE)))
	   (COND
	    ((GET (SETQ LVRL (CAR (STATUS MACRO /`))) 'SUBR))
	    ((OR (AND (SETQ LVRL (GET LVRL 'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;BACKQ FASL has not been found.  Please load it, and resume by <altmod
e>P |)	     (BREAK LOAD-BACKQ-FASL-PLEASE)))
	   (COND
	    ((GET 'DEFMAX 'MACRO))
	    ((OR (AND (SETQ LVRL (GET 'DEFMACRO
				      'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;DEFMAX FASL has not been found.  It has not been loaded - be warned!|
)))	   (COND
	    ((GET 'DEFMACRO 'MACRO))
	    ((OR (AND (SETQ LVRL (GET 'DEFMACRO
				      'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;DEFMACRO FASL has not been found.  It has not been loaded - be warned
!|)))	   (COND
	    ((GET 'GETMIDASOP 'SUBR))
	    ((OR (AND (SETQ LVRL (GET 'GETMIDASOP
				      'AUTOLOAD))
		      (PROBEF LVRL))
		 (AND (SETQ LVRL (MERGEF (LIST CCLOAD:DEV-DIR) LVRL))
		      (PROBEF LVRL)))
	     (LOAD LVRL))
	    ('T
	     (PRINC
	      '
|/
;GETMID FASL has not been found.  Please load it, and resume by <altmo
de>P |)	     (BREAK LOAD-GETMID-FASL-PLEASE))))
	  (COND ((FIXP PURE) PURE) ('T))))
       (AND PURE (PAGEBPORG))
       (SETQ CCLOAD:DEV-DIR
	     (COND ((STATUS FEATURE ITS) '(DSK COMLAP))
		   ((AND (STATUS FEATURE DEC20)
			 (PROBEF '((PS MACLISP) COMPLR FASL)))
		    '(PS MACLISP))
		   ((STATUS FEATURE SAIL) '(DSK (MAC LSP)))
		   ((LIST 'DSK (STATUS UDIR)))))
  C    (SETQ REGPDL (CONS CCLOAD:DEV-DIR '(COMPLR FASL)))
       (AND
	(NOT (STATUS FEATURE ITS))
	(NOT (PROBEF REGPDL))
	(PROG2
	 (PRINC
	  '
|/
;Please set up "CCLOAD:DEV-DIR" to a list of the device and directory 
/
;names to use for the loading the COMPLR and FASLAP FASL files/
|	  TYO)
	 (BREAK ULUZ)
	 (GO C)))
       (COND
	((AND (NOT (EQ PURE 'LAP))
	      (OR (STATUS FEATURE ITS) (PROBEF REGPDL)))
	 (COND
	  ((NULL (GETSP (COND ((MINUSP PURE) 31310)
			      ((STATUS FEATURE SAIL) 143470)
			      (125740))))
	   (PRINC
	    '
|/
;Can't get enough Binary Program Space - You have lost badly!!/
|)	   (BREAK ULUZ)
	   (GO C)))
	 (EVAL GL)
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
Fazloading COMPLR FASL|)
	      TYO)
	 (LOAD REGPDL)
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
  (Compiler version number | TYO)
	      (PRINC COMPLRVERNO TYO)
	      (PRINC '|) | TYO))
	 (PAGEBPORG))
	((STATUS FEATURE ITS)
	 (COND ((EQ PURE 'LAP)
		(SSTATUS TTY
			 (BOOLE 7
				(CAR (SETQ UNSFLST (STATUS TTY)))
				200←22)
			 (CADR UNSFLST))
		(PRINC '|/
FASLAP too?(Y or N) | TYO)
		(SETQ FLPDL (EQ (READCH NIL TYI) 'Y))
		(SSTATUS TTY (CAR UNSFLST) (CADR UNSFLST))))
	 (EVAL LVRL)
	 (EVAL GL)
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
LAPping in COMPLR LAP | TYO))
	 (LOAD (CONS CCLOAD:DEV-DIR '(COMPLR LAP))))
	('T
	 (PRINC '|You Lose, Bunkie! Where is COMPLR file?|)
	 (BREAK CANT-FIND-COMPLR)
	 (GO C)))
       (COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR
				     '(PHAS1 FASL))))
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
Fazloading PHAS1 FASL| TYO))
	      (LOAD GL)
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
  (PHAS1 version number | TYO)
		   (PRINC PHAS1VERNO TYO)
		   (PRINC '|) | TYO)))
	     ('T
	      (PRINC '|You Lose, Bunkie! Where is PHAS1 file?|)
	      (BREAK CANT-FIND-PHAS1)
	      (GO C)))
       (COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR
				     '(COMAUX FASL))))
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
Fazloading COMAUX FASL| TYO))
	      (LOAD GL)
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
  (COMAUX version number | TYO)
		   (PRINC COMAUXVERNO TYO)
		   (PRINC '|) | TYO)))
	     ('T
	      (PRINC '|You Lose, Bunkie! Where is COMAUX file?|)
	      (BREAK CANT-FIND-COMAUX)
	      (GO C)))
       (COND
	(FLPDL
	 (SETQ REGPDL (CONS CCLOAD:DEV-DIR '(FASLAP FASL)))
	 (COND ((NOT (PROBEF REGPDL))
		(PRINC '|/
You lose, Bunkie! Where is FASLAP file?|)
		(BREAK CANT-FIND-FASLAP)
		(GO C)))
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
Fazloading FASLAP FASL| TYO))
	 (LOAD REGPDL)
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
  (FASLAP version number | TYO)
	      (PRINC FASLVERNO TYO)
	      (PRINC '|) | TYO))))
       (COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR
				     '(MAKLAP FASL))))
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
Fazloading MAKLAP FASL| TYO))
	      (LOAD GL)
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
  (MAKLAP version number | TYO)
		   (PRINC MAKLAPVERNO TYO)
		   (PRINC '|) | TYO)))
	     ('T
	      (PRINC '|You Lose, Bunkie! Where is MAKLAP file?|)
	      (BREAK CANT-FIND-MAKLAP)
	      (GO C)))
       (COND ((PROBEF (SETQ GL (CONS CCLOAD:DEV-DIR
				     '(INITIA FASL))))
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
Fazloading INITIA FASL| TYO))
	      (LOAD GL)
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
  (INITIA version number | TYO)
		   (PRINC INITIAVERNO TYO)
		   (PRINC '|) | TYO)))
	     ('T
	      (PRINC '|You Lose, Bunkie! Where is INITIA file?|)
	      (BREAK CANT-FIND-INITIA)
	      (GO C)))
       (COND
	((PROBEF (SETQ GL
		       (LIST CCLOAD:DEV-DIR
			     (MAKNAM (NCONC (EXPLODEN COMPLRVERNO)
					    '(C F)))
			     'FASL)))
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
Fazloading COMPLR fix file | TYO)
	      (PRINC (CADR GL) TYO))
	 (LOAD GL)))
       (COND
	((PROBEF (SETQ GL
		       (LIST CCLOAD:DEV-DIR
			     (MAKNAM (NCONC (EXPLODEN COMPLRVERNO)
					    '(F F)))
			     'FASL)))
	 (AND (NOT CCLOAD:FLUSH-TTY)
	      (PRINC '|/
Fazloading FASLAP fix file | TYO)
	      (PRINC (CADR GL) TYO))
	 (APPLY 'FASLOAD GL)))
       (COND ((STATUS FEATURE SAIL)
	      (AND (NOT CCLOAD:FLUSH-TTY)
		   (PRINC '|/
SAIL-specific loadings: |)
		   (PRINC '|/
  direct |))  (LOAD (COND ((STATUS FEATURE DDT)
			   '((DSK (MAC LSP)) DIRECT DFA))
			  ('((DSK (MAC LSP)) DIRECT FAS))))
	      (MAPC 
	       '(LAMBDA (GL) 
			(AND (NOT CCLOAD:FLUSH-TTY) (PRINC (CAR GL)))
			(LOAD (CDR GL)))
	       '((|/
  eread | (DSK (MAC LSP)) EREAD FAS)
		 (|/
  macrodef | (DSK (MAC LSP)) MACROD FAS)
		 (|/
  require | (DSK (MAC LSP)) NCOREQ FAS)
		 (|/
  loaded | (DSK (MAC LSP)) LOADED FAS)))
	      (SETQ SAIL-MORE-SYSFUNS
		    (APPEND '(EREAD EOPEN
				    ELOAD
				    UGREAT1
				    REQUIRE
				    EDIT
				    CODE
				    MACRODEF
				    MACROBIND
				    TRANS
				    TRANSDEF
				    MAIL
				    %MATCH
				    %CONTINUE
				    %CONTINUE-MATCH
				    %CHAR1
				    %MATCH-LOOKUP
				    %%DESTRUCTURIFY%%
				    %%DESTRUCTURE1%%
				    %%PATHIFY%%
				    %%CODE-PATH%%
				    %%EXPAND%%
				    %%EXPAND1%%
				    %%%STRING%%%)
			    SAIL-MORE-SYSFUNS))
	      (MAPC 
	       '(LAMBDA (X) 
			(COND ((GET (CAR X) 'AUTOLOAD)
			       (AND (CDDR X) (ARGS (CAR X) (CDDR X)))
			       (AND (CDR X)
				    (PUTPROP (CAR X)
					     (CDR X)
					     'FUNTYP-INFO)))))
	       '((EREAD FSUBR) (EOPEN LSUBR 0 . 4)
		 (ELOAD SUBR NIL . 1) (UGREAT1 SUBR NIL . 1)
		 (REQUIRE FSUBR) (EDIT FSUBR) (CODE FSUBR)
		 (MAIL FSUBR)))))
       (AND (NOT CCLOAD:FLUSH-TTY)
	    (PRINC '|/
Initializing | TYO))
       (INITIALIZE)
       (AND (STATUS FEATURE ITS) (ALARMCLOCK 'TIME -1))
       (COND (CCLOAD:FLUSH-TTY)
	     ('T
	      (PRINC '|/
Total Time = | TYO)
	      (PRINC (*QUO (FIX (*QUO (- (RUNTIME) RUNTIME) 
100000.0))		   10.0)
		     TYO)
	      (PRINC '| secs out of | TYO)
	      (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 
10.0)) 10.0) TYO)
	      (TERPRI)))
       (AND (NULL FXPDL) (SSTATUS NOFEATURE NOLDMSG))
       (SETQ ALARMCLOCK NIL ↑Q NIL ↑W NIL))
 (I